home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / winfo151 / winfo151.exe / FRMMAIN1.PAS < prev    next >
Pascal/Delphi Source File  |  1995-09-06  |  8KB  |  306 lines
  1. unit Frmmain1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, Menus, ExtCtrls,
  8.   frmAbout, TabNotBk, FileCtrl, Gauges,
  9.   readme;
  10.  
  11. type
  12.   TfrmNmfiMain = class(TForm)
  13.     ToolBar: TPanel;
  14.     StatusBar: TPanel;
  15.     sbExit: TSpeedButton;
  16.     sbAbout: TSpeedButton;
  17.     chkConfirmExit: TCheckBox;
  18.     TabbedNotebook1: TTabbedNotebook;
  19.     cbDrive: TDriveComboBox;
  20.     Label6: TLabel;
  21.     Label7: TLabel;
  22.     Label8: TLabel;
  23.     txtDriveType: TEdit;
  24.     txtDriveSize: TEdit;
  25.     txtDriveFree: TEdit;
  26.     Gauge1: TGauge;
  27.     Label9: TLabel;
  28.     Label1: TLabel;
  29.     txtSysMem: TEdit;
  30.     Bevel1: TBevel;
  31.     GroupBox1: TGroupBox;
  32.     gageGDI: TGauge;
  33.     Label11: TLabel;
  34.     gageUser: TGauge;
  35.     Label12: TLabel;
  36.     Label13: TLabel;
  37.     Label14: TLabel;
  38.     pnlWinDir: TPanel;
  39.     pnlWinSysDir: TPanel;
  40.     GroupBox2: TGroupBox;
  41.     Label2: TLabel;
  42.     Label3: TLabel;
  43.     Label4: TLabel;
  44.     Label5: TLabel;
  45.     txtWinVer: TEdit;
  46.     txtDosVer: TEdit;
  47.     txtCPU: TEdit;
  48.     txtMathCo: TEdit;
  49.     txtWinMode: TEdit;
  50.     Label10: TLabel;
  51.     txtPageMem: TEdit;
  52.     Label15: TLabel;
  53.     Bevel2: TBevel;
  54.     cmdCompact: TBitBtn;
  55.     cbOnTop: TCheckBox;
  56.     SpeedButton1: TSpeedButton;
  57.     procedure Exit1Click(Sender: TObject);
  58.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  59.     procedure FormCreate(Sender: TObject);
  60.     procedure sbExitClick(Sender: TObject);
  61.     procedure sbAboutClick(Sender: TObject);
  62.     procedure chkConfirmExitClick(Sender: TObject);
  63.     procedure cbDriveChange(Sender: TObject);
  64.     procedure TabbedNotebook1Click(Sender: TObject);
  65.     procedure cmdCompactClick(Sender: TObject);
  66.     procedure cbOnTopClick(Sender: TObject);
  67.     procedure SpeedButton1Click(Sender: TObject);
  68.   private
  69.     { Private declarations }
  70.     FileNeedsToBeSaved : BOOLEAN;
  71.     FileName : string;
  72.     AppTitle : string;
  73.     ConfirmExit : BOOLEAN;
  74.   public
  75.     { Public declarations }
  76.     procedure    DisplayHint(Sender:TObject);
  77.     procedure    GetSystemInformation;
  78.     procedure    GetDiskInfo(szDisk : char);
  79.     procedure    GetMemoryInformation;
  80.   end;
  81.  
  82. var
  83.   frmNmfiMain: TfrmNmfiMain;
  84.  
  85. implementation
  86.  
  87. {$R *.DFM}
  88.  
  89. procedure TfrmNmfiMain.DisplayHint(Sender: TObject);
  90. begin
  91. StatusBar.Caption := Application.Hint;
  92. end;
  93.  
  94. procedure TfrmNmfiMain.GetDiskInfo(szDisk : char);
  95.    function DriveType(ltr : char) : string;
  96.    var d : integer;
  97.    begin
  98.    d := ord(UpCase(ltr)) - ORD('A');
  99.    if d in [0..25] then
  100.    begin
  101.       d := GetDriveType(d);
  102.       case d of
  103.       DRIVE_REMOVABLE  : Result := 'Floppy Drive';
  104.       DRIVE_FIXED      : Result := 'Hard Drive';
  105.       DRIVE_REMOTE     : Result := 'CD or Network Drive';
  106.       else Result := 'Unknown Drive Type';
  107.       end; { case }
  108.    end
  109.    else
  110.       Result := ltr + ' is a bad Drive letter.'
  111.    end;
  112. var    lReturn, Factor  :longint;
  113.        aLabel           : string[2];
  114. const  KB = 1024;
  115. begin
  116.      szDisk := (UpCase(szDisk));
  117.  
  118.      txtDriveType.text := DriveType(szDisk);
  119.  
  120.      lReturn := DiskSize( ord(szDisk) - ord('A') + 1 );
  121.      if lReturn > (10 * (KB * KB)) then
  122.      begin
  123.           factor := (KB * KB);
  124.           aLabel := 'MB';
  125.      end
  126.      else
  127.      begin
  128.          factor := kb;
  129.          aLabel := 'KB';
  130.      end;
  131.  
  132.      txtDriveSize.Text := IntToStr( lReturn div factor ) + alabel;
  133.      Gauge1.MaxValue := lReturn div factor ;
  134.  
  135.      lReturn := DiskFree( ord(szDisk) - ord('A') + 1 );
  136.      txtDriveFree.Text := IntToStr( lReturn div factor ) + alabel;
  137.      Gauge1.Progress := lReturn  div factor ;
  138.  
  139.      Caption := AppTitle + ' - ' + IntToStr(Gauge1.PercentDone) + '% Free Disk Space';
  140.      Application.Title := Caption;
  141. end;
  142.  
  143. procedure TfrmNmfiMain.GetMemoryInformation;
  144. begin
  145.   { Global Heap }
  146.   txtSysMem.Text := IntToStr(GetFreeSpace(0) DIV 1024) + 'K';
  147.   { System Resources }
  148.   Caption := AppTitle + ' - ' +
  149.           IntToStr(GetFreeSystemResources(GFSR_SYSTEMRESOURCES)) + '% Free Resources';
  150.   Application.Title := Caption;
  151.  
  152.   gageUSER.Progress := GetFreeSystemResources(GFSR_USERRESOURCES);
  153.   gageGDI.Progress := GetFreeSystemResources(GFSR_GDIRESOURCES);
  154. end;
  155.  
  156. procedure TfrmNmfiMain.GetSystemInformation;
  157. var
  158.    dwSysflags,
  159.    dwAvailable,
  160.    dwVersion           : longint;
  161.    wDosVer, wWinVer    : WORD;
  162.    b : array[0..144] of char;
  163.  
  164. begin
  165.   Caption := AppTitle;
  166.   Application.Title := Caption;
  167.  
  168.   { Win & DOS Versions }
  169.   dwVersion := GetVersion;
  170.   wWinVer := LoWord(dwVersion);
  171.   txtWinVer.Text := IntToStr(LoByte(wWinVer)) + '.' + IntToStr(HiByte(wWinVer));
  172.   wDosVer := HiWord(dwVersion);
  173.   txtDosVer.Text := IntToStr(HiByte(wDosVer)) + '.' + IntToStr(LoByte(wDosVer));
  174.  
  175.   { WinFlags }
  176.   dwSysFlags := GetWinFlags;
  177.  
  178.   if (dwSysFlags and WF_WIN386) = WF_WIN386 then txtWinMode.Text := '386 Enhanced'
  179.   else txtWinMode.Text := 'Standard';
  180.  
  181.   if (dwSysFlags and WF_80x87) = WF_80x87 then txtMathCo.Text := 'Yes'
  182.   else txtMathCo.Text := 'No';
  183.  
  184.   if (dwSysFlags and WF_Paging) = WF_Paging then txtPageMem.Text := 'Yes'
  185.   else txtPageMem.Text := 'No';
  186.  
  187.   if (dwSysFlags and WF_CPU286) = WF_CPU286 then
  188.       txtCPU.Text := '80286'
  189.   else
  190.   if (dwSysFlags and WF_CPU386) = WF_CPU386 then
  191.       txtCPU.Text := '80386'
  192.   else
  193.   if (dwSysFlags and WF_CPU486) = WF_CPU486 then
  194.       txtCPU.Text := '80486 or better'
  195.   else        txtCPU.Text := 'unknown type';
  196. { Win directory locations }
  197.   GetWindowsDirectory(b,sizeof(b));
  198.   pnlWinDir.Caption := strpas(b);
  199.  
  200.   GetSystemDirectory(b,sizeof(b));
  201.   pnlWinSysDir.Caption := strpas(b);
  202. end;
  203.  
  204. procedure TfrmNmfiMain.Exit1Click(Sender: TObject);
  205. begin
  206. self.close;
  207. end;
  208.  
  209. procedure TfrmNmfiMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  210. begin
  211. if ConfirmExit then
  212.   CanClose := MessageDlg('You are about to close '+ application.Title + '. Are you sure?',
  213.     mtInformation, [mbYes, mbNo], 0) = mrYes;
  214.  
  215. end;
  216.  
  217. procedure TfrmNmfiMain.FormCreate(Sender: TObject);
  218. begin
  219.   FileNeedsToBeSaved := FALSE;
  220.   ConfirmExit := FALSE;
  221.   FileName := '';
  222.   Application.OnHint := DisplayHint;
  223.   AppTitle := Application.Title;
  224.   self.top := (Screen.Height - self.height) div 4  ;
  225.   self.left := (Screen.Width - self.Width) div 4 ;
  226.   GetSystemInformation;
  227. end;
  228.  
  229. procedure TfrmNmfiMain.sbExitClick(Sender: TObject);
  230. begin
  231. self.Close;
  232. end;
  233.  
  234. procedure TfrmNmfiMain.sbAboutClick(Sender: TObject);
  235. var StayOnTop : boolean;
  236.     f : TfrmNmfiAbout;
  237. begin
  238.   StayOnTop := cbOnTop.Checked;
  239.   if cbOnTop.Checked then cbOnTop.Checked := false;
  240.   try
  241.   f := TfrmNmfiAbout.Create(self);
  242.   f.ShowModal;
  243.   finally
  244.   f.free;
  245.   end;
  246.   if StayOnTop then cbOnTop.Checked := True;
  247. end;
  248.  
  249. procedure TfrmNmfiMain.chkConfirmExitClick(Sender: TObject);
  250. begin
  251. ConfirmExit := chkConfirmExit.checked;
  252. end;
  253.  
  254. procedure TfrmNmfiMain.cbDriveChange(Sender: TObject);
  255. begin
  256.      GetDiskInfo(cbDrive.Drive);
  257. end;
  258.  
  259. procedure TfrmNmfiMain.TabbedNotebook1Click(Sender: TObject);
  260. begin
  261.   case TabbedNotebook1.PageIndex of { which tab was clicked? }
  262.   0 : begin
  263.       GetSystemInformation;
  264.       TabbedNotebook1.Hint := 'System Statistics.'
  265.       end;
  266.   1 : begin
  267.         GetDiskInfo(cbDrive.Drive);
  268.         TabbedNotebook1.Hint := 'Disk Drive Statistics.'
  269.       end;
  270.   2 : begin
  271.         GetMemoryInformation;
  272.         TabbedNotebook1.Hint := 'Resource Statistics.'
  273.       end;
  274.   end; { case }
  275. end;
  276.  
  277. procedure TfrmNmfiMain.cmdCompactClick(Sender: TObject);
  278. var mem : longint;
  279. begin
  280.   Screen.Cursor := crHourglass;
  281. (*  mem := GlobalCompact(0); { how much is there to free? } *)
  282.   mem := $ffffff;
  283.   GlobalCompact(mem); { free it }
  284.   GetMemoryInformation;
  285.   Screen.Cursor := crDefault;
  286. end;
  287.  
  288. procedure TfrmNmfiMain.cbOnTopClick(Sender: TObject);
  289. begin
  290.   if cbOnTop.checked then frmNmfiMain.FormStyle := fsStayOnTop
  291.   else frmNmfiMain.FormStyle := fsNormal;
  292. end;
  293.  
  294. procedure TfrmNmfiMain.SpeedButton1Click(Sender: TObject);
  295. var f : TfrmReadMe;
  296. begin
  297.   try
  298.   f := TfrmReadMe.Create(self);
  299.   f.showmodal;
  300.   finally
  301.   f.Free;
  302.   end;
  303. end;
  304.  
  305. end.
  306.